#' Online ADOSC
#'
#' @param period rolling window period
#' @param type calculate ADOSC or AD
#'
#' @return a stateful function
#' @export
#'
new_adosc <- function(period, type = c("adosc", "ad"))
{
  type = match.arg(type)
  new_name <- paste0(type, "_new")
  run_name <- paste0(type, "_run")
  new_func <- match.fun(new_name)
  run_func <- match.fun(run_name)
  if (type == "adosc")
  {
    ptr <- new_func(period)
  } else {
    ptr <- new_func()
  }
  function(high, low, close, volume)
  {
    n1 <- length(high)
    n2 <- length(low)
    n3 <- length(close)
    n4 <- length(volume)
    if (!(n1 == n2 && n2 == n3 && n3 == n4))
    {
      stop("Input lengths do not match.")
    }
    run_func(ptr, high, low, close, volume)
  }
}

#' Online ATR
#'
#' @param period rolling window period
#'
#' @return a stateful function
#' @export
#'
new_atr <- function(period)
{
  type = "atr"
  new_name <- paste0(type, "_new")
  run_name <- paste0(type, "_run")
  new_func <- match.fun(new_name)
  run_func <- match.fun(run_name)

  ptr <- new_func(period)

  function(high, low, close)
  {
    n1 <- length(high)
    n2 <- length(low)
    n3 <- length(close)
    if (!(n1 == n2 && n2 == n3))
    {
      stop("Input lengths do not match.")
    }
    run_func(ptr, high, low, close)
  }
}

#' Online BOP
#'
#' @return a stateful function
#' @export
#'
new_bop <- function()
{
  type = "bop"
  new_name <- paste0(type, "_new")
  run_name <- paste0(type, "_run")
  new_func <- match.fun(new_name)
  run_func <- match.fun(run_name)

  ptr <- new_func()

  function(open, high, low, close)
  {
    n1 <- length(high)
    n2 <- length(low)
    n3 <- length(close)
    n4 <- length(open)
    if (!(n1 == n2 && n2 == n3 && n3 == n4))
    {
      stop("Input lengths do not match.")
    }
    run_func(ptr, open, high, low, close)
  }
}

#' Online CMO
#'
#' @param period rolling window period
#'
#' @return a stateful function
#' @export
#'
new_cmo <- function(period)
{
  mk_online_func_x("cmo", period)
}

#' Online CVI
#'
#' @param period rolling window period
#'
#' @return a stateful function
#' @export
#'
new_cvi <- function(period)
{
  type = "cvi"
  new_name <- paste0(type, "_new")
  run_name <- paste0(type, "_run")
  new_func <- match.fun(new_name)
  run_func <- match.fun(run_name)

  ptr <- new_func(period)

  function(high, low)
  {
    n1 <- length(high)
    n2 <- length(low)
    if (!(n1 == n2))
    {
      stop("Input lengths do not match.")
    }
    run_func(ptr, high, low)
  }
}

#' Online signal decay
#'
#' @param rate decay rate
#' @param type type of decay
#'
#' @return a stateful function
#' @export
#'
new_decay <- function(rate, type = c("exp", "linear"))
{
  type <- match.arg(type)
  type <- paste0("decay_", type)
  mk_online_func_x(type, rate)
}

#' Online DPO
#'
#' @param period rolling window period
#'
#' @return a stateful function
#' @export
#'
new_dpo <- function(period)
{
  mk_online_func_x("dpo", period)
}

#' Online EMV
#'
#' @param scale scaling factor to make volume close to price level
#'
#' @return a stateful function
#' @export
#'
new_emv <- function(scale = 0.0001)
{
  type = "emv"
  new_name <- paste0(type, "_new")
  run_name <- paste0(type, "_run")
  new_func <- match.fun(new_name)
  run_func <- match.fun(run_name)

  ptr <- new_func(scale)

  function(high, low, volume)
  {
    n1 <- length(high)
    n2 <- length(low)
    n3 <- length(volume)
    if (!(n1 == n2 && n2 == n3))
    {
      stop("Input lengths do not match.")
    }
    run_func(ptr, high, low, volume)
  }
}

#' Online MASS
#'
#' @param period rolling window period
#'
#' @return a stateful function
#' @export
#'
new_mass <- function(period)
{
  mk_online_func_x("mass", period)
}

#' Online MFI
#'
#' @param period rolling window period
#'
#' @return a stateful function
#' @export
#'
new_mfi <- function(period)
{
  type = "mfi"
  new_name <- paste0(type, "_new")
  run_name <- paste0(type, "_run")
  new_func <- match.fun(new_name)
  run_func <- match.fun(run_name)

  ptr <- new_func(period)

  function(close, turnover)
  {
    n1 <- length(close)
    n2 <- length(turnover)
    if (!(n1 == n2))
    {
      stop("Input lengths do not match.")
    }
    run_func(ptr, close, turnover)
  }
}

#' Online OBV
#'
#' @return a stateful function
#' @export
#'
new_obv <- function()
{
  type = "obv"
  new_name <- paste0(type, "_new")
  run_name <- paste0(type, "_run")
  new_func <- match.fun(new_name)
  run_func <- match.fun(run_name)

  ptr <- new_func()

  function(price, volume)
  {
    n1 <- length(price)
    n2 <- length(volume)
    if (!(n1 == n2))
    {
      stop("Input lengths do not match.")
    }
    run_func(ptr, price, volume)
  }
}

#' Online PSAR
#'
#' @param acc_init init acc factor
#' @param acc_max max acc factor
#'
#' @return a stateful function
#' @export
#'
new_psar <- function(acc_init = 0.02, acc_max = 0.2)
{
  type = "psar"
  new_name <- paste0(type, "_new")
  run_name <- paste0(type, "_run")
  new_func <- match.fun(new_name)
  run_func <- match.fun(run_name)

  ptr <- new_func(acc_init, acc_max)

  function(high, low)
  {
    n1 <- length(high)
    n2 <- length(low)
    if (!(n1 == n2))
    {
      stop("Input lengths do not match.")
    }
    run_func(ptr, high, low)
  }
}

#' Online roll sum
#'
#' @param period rolling period window
#'
#' @return a stateful function
#' @export
#'
new_rollsum <- function(period)
{
  mk_online_func_x("rollsum", period)
}

#' Online STOSC
#'
#' @param period rolling window period
#'
#' @return a stateful function
#' @export
#'
new_stosc <- function(period)
{
  type = "stosc"
  new_name <- paste0(type, "_new")
  run_name <- paste0(type, "_run")
  new_func <- match.fun(new_name)
  run_func <- match.fun(run_name)

  ptr <- new_func(period)

  function(high, low, close)
  {
    n1 <- length(high)
    n2 <- length(low)
    n3 <- length(close)
    if (!(n1 == n2 && n2 == n3))
    {
      stop("Input lengths do not match.")
    }
    run_func(ptr, high, low, close)
  }
}

#' Online VHF
#'
#' @param period rolling period window
#'
#' @return a stateful function
#' @export
#'
new_vhf <- function(period)
{
  mk_online_func_x("vhf", period)
}

#' Online VOLIDX
#'
#' @param initialise initial PVI/NVI value
#'
#' @return a stateful function
#' @export
#'
new_volidx <- function(initialise = 1000.)
{
  type = "volidx"
  new_name <- paste0(type, "_new")
  run_name <- paste0(type, "_run")
  new_func <- match.fun(new_name)
  run_func <- match.fun(run_name)

  ptr <- new_func(initialise)

  function(price, volume)
  {
    n1 <- length(price)
    n2 <- length(volume)
    if (!(n1 == n2))
    {
      stop("Input lengths do not match.")
    }
    run_func(ptr, price, volume)
  }
}

#' Online WAD
#'
#' @return a stateful function
#' @export
#'
new_wad <- function()
{
  type = "wad"
  new_name <- paste0(type, "_new")
  run_name <- paste0(type, "_run")
  new_func <- match.fun(new_name)
  run_func <- match.fun(run_name)

  ptr <- new_func()

  function(high, low, close)
  {
    n1 <- length(high)
    n2 <- length(low)
    n3 <- length(close)
    if (!(n1 == n2 && n2 == n3))
    {
      stop("Input lengths do not match.")
    }
    run_func(ptr, high, low, close)
  }
}

#' Online WILLR
#'
#' @param period rolling window period
#'
#' @return a stateful function
#' @export
#'
new_willr <- function(period)
{
  type = "willr"
  new_name <- paste0(type, "_new")
  run_name <- paste0(type, "_run")
  new_func <- match.fun(new_name)
  run_func <- match.fun(run_name)

  ptr <- new_func(period)

  function(high, low, close)
  {
    n1 <- length(high)
    n2 <- length(low)
    n3 <- length(close)
    if (!(n1 == n2 && n2 == n3))
    {
      stop("Input lengths do not match.")
    }
    run_func(ptr, high, low, close)
  }
}
